{$A8,B-,C+,D+,E-,F-,G+,H+,I+,J-,K-,L+,M-,N+,O+,P+,Q-,R-,S-,T-,U-,V+,W-,X+,Y+,Z1}
{$WARN UNSAFE_TYPE OFF}

unit GrfInterface;

interface

  uses
    Interface_TLB, ComObj, ExtActns, Windows, grf, grftypes;

  type
    TGrfInterface = class(TAutoIntfObject, IGrfObjectIntf, IDispatch)
      private
        fGrf : PGrf;
      protected
        function Get_fileCount: LongWord; safecall;
        function Files(index: LongWord): OleVariant; safecall;
        function Add(const grffile_path: WideString): OleVariant; safecall;
        function Merge(grffile_handle: LongWord): WordBool; safecall;
        function Repack: OleVariant; safecall;
        procedure Save; safecall;
        function Get_Size: Integer; safecall;
        property fileCount: LongWord read Get_fileCount;
        property Size: Integer read Get_Size;
      public
        constructor Create(Grf : PGrf);
        destructor Destroy(); override;
    end;

implementation

  uses
    ActiveX, GrfFileInterface, Variants, Dialogs;

  constructor TGrfInterface.Create(Grf : PGrf);
  var
    TypeLib : ITypeLib;
    ExeName : WideString;
  begin
    //Get name of application
    ExeName := ParamStr(0);
    //Load type library from application's resources
    OleCheck(LoadTypeLib(PWideChar(ExeName), TypeLib));
    //Inherit
    inherited Create(TypeLib, IGrfObjectIntf);
    fGrf := Grf;
  end;

  destructor TGrfInterface.Destroy();
  begin
    inherited;
    grf_free(fGrf);
  end;

  function TGrfInterface.Get_fileCount() : Cardinal;
  begin
    try
      Result := fGrf.nfiles;
    except
      Result := 0;
    end;
  end;

  function TGrfInterface.Files(index: Cardinal) : OleVariant;
  begin
    try
      if index < fGrf.len then
        Result := IDispatch(TGrfFileInterface.Create(fGrf, fGrf.files[index], index))
      else
        Result := VarAsType(Result, varEmpty);
    except
      Result := VarAsType(Result, varEmpty);
    end;
  end;

  function TGrfInterface.Add(const grffile_path: WideString) : OleVariant;
  begin
    Result := true;
  end;

  function TGrfInterface.Merge(grffile_handle: LongWord): WordBool; safecall;
  var
    GrfFile : TGrfFileInterface;
    Grf : PGrf;
    DataBuffer : Pointer;
    Size : Cardinal;
    Error : TGrfError;
  begin
    Result := false;
    Grf := nil;
    GrfFile := nil;
    try
      GrfFile := TGrfFileInterface(Pointer(grffile_handle));
    finally
      if GrfFile <> nil then
      begin
        try
          Grf := Pointer(GrfFile.GrfPointer);
        finally
          if Grf <> nil then
          begin
            if GRFFILE_IS_DIR(Grf.files[GrfFile.GrfFileIndex]) = false then
            begin
              DataBuffer := grf_index_get(
                Grf,
                GrfFile.GrfFileIndex,
                Size,
                Error
              );
              grf_put(
                fGrf,
                Grf.files[GrfFile.GrfFileIndex].name,
                DataBuffer,
                Size,
                GRFFILE_FLAG_FILE,
                Error
              );
              Result := true;
            end;
          end;
        end;
      end;

    end;
  end;

  function TGrfInterface.Repack() : OleVariant;
  begin
    //
  end;

  procedure TGrfInterface.Save();
  var
    Error : TGrfError;
    function FlushCallback(grffile : PGrfFile; error : PGrfError) : Integer; cdecl;
    begin
      Result := 0;
    end;
  begin
    grf_callback_flush(fGrf, Error, @FlushCallback);
  end;

  function TGrfInterface.Get_Size() : Integer;
  begin
    Result := 0;
    try
      Result := fGrf.len;
    except end;
  end;

end.
